home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / mlconvert.el.z / mlconvert.el
Encoding:
Text File  |  1998-10-28  |  10.1 KB  |  289 lines
  1. ;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp.
  2.  
  3. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6. ;; Keywords: emulations
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This package converts Mocklisp code written under a Gosling or UniPress
  28. ;; Emacs for use with GNU Emacs.  The translated code will require runtime
  29. ;; support from the mlsupport.el equivalent.
  30.  
  31. ;;; Code:
  32.  
  33. ;;;###autoload
  34. (defun convert-mocklisp-buffer ()
  35.   "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
  36.   (interactive)
  37.   (emacs-lisp-mode)
  38.   (set-syntax-table (copy-sequence (syntax-table)))
  39.   (modify-syntax-entry ?\| "w")
  40.   (message "Converting mocklisp (ugh!)...")
  41.   (goto-char (point-min))
  42.   (fix-mlisp-syntax)
  43.  
  44.   ;; Emulation of mocklisp is accurate only within a mocklisp-function
  45.   ;; so turn any non-function into a defun and then call it.
  46.   (goto-char (point-min))
  47.   (condition-case ignore
  48.       (while t
  49.     (let ((opt (point))
  50.           (form (read (current-buffer))))
  51.       (and (listp form)
  52.            (not (eq (car form) 'defun))
  53.            (progn (insert "))\n\n(ml-foo)\n\n")
  54.               (save-excursion
  55.             (goto-char opt)
  56.             (skip-chars-forward "\n")
  57.             (insert "(defun (ml-foo \n "))))))
  58.     (end-of-file nil))
  59.  
  60.   (goto-char (point-min))
  61.   (insert ";;; GNU Emacs code converted from Mocklisp\n")
  62.   (insert "(require 'mlsupport)\n\n")
  63.   (fix-mlisp-symbols)
  64.  
  65.   (goto-char (point-min))
  66.   (message "Converting mocklisp...done"))
  67.  
  68. (defun fix-mlisp-syntax ()
  69.   (while (re-search-forward "['\"]" nil t)
  70.     (if (= (preceding-char) ?\")
  71.     (progn (forward-char -1)
  72.            (forward-sexp 1))
  73.       (delete-char -1)
  74.       (insert "?")
  75.     (if (or (= (following-char) ?\\) (= (following-char) ?^))
  76.       (forward-char 1)
  77.     (if (looking-at "[^a-zA-Z]")
  78.         (insert ?\\)))
  79.       (forward-char 1)
  80.       (delete-char 1))))
  81.  
  82. (defun fix-mlisp-symbols ()
  83.   (while (progn
  84.        (skip-chars-forward " \t\n()")
  85.        (not (eobp)))
  86.     (cond ((or (= (following-char) ?\?)
  87.            (= (following-char) ?\"))
  88.        (forward-sexp 1))
  89.       ((= (following-char) ?\;)
  90.        (forward-line 1))
  91.       (t
  92.        (let ((start (point)) prop)
  93.          (forward-sexp 1)
  94.          (setq prop (get (intern-soft (buffer-substring start (point)))
  95.                  'mocklisp))
  96.          (cond ((null prop))
  97.            ((stringp prop)
  98.             (delete-region start (point))
  99.             (insert prop))
  100.            (t
  101.             (save-excursion
  102.               (goto-char start)
  103.               (funcall prop)))))))))
  104.  
  105. (defun ml-expansion (ml-name lisp-string)
  106.   (put ml-name 'mocklisp lisp-string))
  107.  
  108. (ml-expansion 'defun "ml-defun")
  109. (ml-expansion 'if "ml-if")
  110. (ml-expansion 'setq '(lambda ()
  111.                (if (looking-at "setq[ \t\n]+buffer-modified-p")
  112.                (replace-match "set-buffer-modified-p"))))
  113.  
  114. ;;(ml-expansion 'while '(lambda ()
  115. ;;             (let ((end (progn (forward-sexp 2) (point-marker)))
  116. ;;                   (start (progn (forward-sexp -1) (point))))
  117. ;;               (let ((cond (buffer-substring start end)))
  118. ;;                 (cond ((equal cond "1")
  119. ;;                    (delete-region (point) end)
  120. ;;                    (insert "t"))
  121. ;;                   (t
  122. ;;                    (insert "(not (zerop ")
  123. ;;                    (goto-char end)
  124. ;;                    (insert "))")))
  125. ;;                 (set-marker end nil)
  126. ;;                 (goto-char start)))))
  127.  
  128. (ml-expansion 'arg "ml-arg")
  129. (ml-expansion 'nargs "ml-nargs")
  130. (ml-expansion 'interactive "ml-interactive")
  131. (ml-expansion 'message "ml-message")
  132. (ml-expansion 'print "ml-print")
  133. (ml-expansion 'set "ml-set")
  134. (ml-expansion 'set-default "ml-set-default")
  135. (ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument")
  136. (ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop")
  137. (ml-expansion 'prefix-argument "ml-prefix-arg")
  138. (ml-expansion 'use-local-map "ml-use-local-map")
  139. (ml-expansion 'use-global-map "ml-use-global-map")
  140. (ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry")
  141. (ml-expansion 'error-message "error")
  142.  
  143. (ml-expansion 'dot "point-marker")
  144. (ml-expansion 'mark "mark-marker")
  145. (ml-expansion 'beginning-of-file "beginning-of-buffer")
  146. (ml-expansion 'end-of-file "end-of-buffer")
  147. (ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark")
  148. (ml-expansion 'set-mark "set-mark-command")
  149. (ml-expansion 'argument-prefix "universal-arg")
  150.  
  151. (ml-expansion 'previous-page "ml-previous-page")
  152. (ml-expansion 'next-page "ml-next-page")
  153. (ml-expansion 'next-window "ml-next-window")
  154. (ml-expansion 'previous-window "ml-previous-window")
  155.  
  156. (ml-expansion 'newline "ml-newline")
  157. (ml-expansion 'next-line "ml-next-line")
  158. (ml-expansion 'previous-line "ml-previous-line")
  159. (ml-expansion 'self-insert "self-insert-command")
  160. (ml-expansion 'meta-digit "digit-argument")
  161. (ml-expansion 'meta-minus "negative-argument")
  162.  
  163. (ml-expansion 'newline-and-indent "ml-newline-and-indent")
  164. (ml-expansion 'yank-from-killbuffer "yank")
  165. (ml-expansion 'yank-buffer "insert-buffer")
  166. (ml-expansion 'copy-region "copy-region-as-kill")
  167. (ml-expansion 'delete-white-space "delete-horizontal-space")
  168. (ml-expansion 'widen-region "widen")
  169.  
  170. (ml-expansion 'forward-word '(lambda ()
  171.                    (if (looking-at "forward-word[ \t\n]*)")
  172.                    (replace-match "forward-word 1)"))))
  173. (ml-expansion 'backward-word '(lambda ()
  174.                    (if (looking-at "backward-word[ \t\n]*)")
  175.                    (replace-match "backward-word 1)"))))
  176.  
  177. (ml-expansion 'forward-paren "forward-list")
  178. (ml-expansion 'backward-paren "backward-list")
  179. (ml-expansion 'search-reverse "ml-search-backward")
  180. (ml-expansion 're-search-reverse "ml-re-search-backward")
  181. (ml-expansion 'search-forward "ml-search-forward")
  182. (ml-expansion 're-search-forward "ml-re-search-forward")
  183. (ml-expansion 'quote "regexp-quote")
  184. (ml-expansion 're-query-replace "query-replace-regexp")
  185. (ml-expansion 're-replace-string "replace-regexp")
  186.  
  187. ; forward-paren-bl, backward-paren-bl
  188.  
  189. (ml-expansion 'get-tty-character "read-char")
  190. (ml-expansion 'get-tty-input "read-input")
  191. (ml-expansion 'get-tty-string "read-string")
  192. (ml-expansion 'get-tty-buffer "read-buffer")
  193. (ml-expansion 'get-tty-command "read-command")
  194. (ml-expansion 'get-tty-variable "read-variable")
  195. (ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input")
  196. (ml-expansion 'get-tty-key "read-key")
  197.  
  198. (ml-expansion 'concat "ml-concat")
  199. (ml-expansion 'c= "char-equal")
  200. (ml-expansion 'goto-character "goto-char")
  201. (ml-expansion 'substr "ml-substr")
  202. (ml-expansion 'variable-apropos "apropos")
  203. (ml-expansion 'execute-mlisp-buffer "eval-current-buffer")
  204. (ml-expansion 'execute-mlisp-file "load")
  205. (ml-expansion 'visit-file "find-file")
  206. (ml-expansion 'read-file "find-file")
  207. (ml-expansion 'write-modified-files "save-some-buffers")
  208. (ml-expansion 'backup-before-writing "make-backup-files")
  209. (ml-expansion 'write-file-exit "save-buffers-kill-emacs")
  210. (ml-expansion 'write-named-file "write-file")
  211. (ml-expansion 'change-file-name "set-visited-file-name")
  212. (ml-expansion 'change-buffer-name "rename-buffer")
  213. (ml-expansion 'buffer-exists "get-buffer")
  214. (ml-expansion 'delete-buffer "kill-buffer")
  215. (ml-expansion 'unlink-file "delete-file")
  216. (ml-expansion 'unlink-checkpoint-files "delete-auto-save-files")
  217. (ml-expansion 'file-exists "file-exists-p")
  218. (ml-expansion 'write-current-file "save-buffer")
  219. (ml-expansion 'change-directory "cd")
  220. (ml-expansion 'temp-use-buffer "set-buffer")
  221. (ml-expansion 'fast-filter-region "filter-region")
  222.  
  223. (ml-expansion 'pending-input "input-pending-p")
  224. (ml-expansion 'execute-keyboard-macro "call-last-kbd-macro")
  225. (ml-expansion 'start-remembering "start-kbd-macro")
  226. (ml-expansion 'end-remembering "end-kbd-macro")
  227. (ml-expansion 'define-keyboard-macro "name-last-kbd-macro")
  228. (ml-expansion 'define-string-macro "ml-define-string-macro")
  229.  
  230. (ml-expansion 'current-column "ml-current-column")
  231. (ml-expansion 'current-indent "ml-current-indent")
  232. (ml-expansion 'insert-character "insert")
  233.  
  234. (ml-expansion 'users-login-name "user-login-name")
  235. (ml-expansion 'users-full-name "user-full-name")
  236. (ml-expansion 'current-time "current-time-string")
  237. (ml-expansion 'current-numeric-time "current-numeric-time-you-lose")
  238. (ml-expansion 'current-buffer-name "buffer-name")
  239. (ml-expansion 'current-file-name "buffer-file-name")
  240.  
  241. (ml-expansion 'local-binding-of "local-key-binding")
  242. (ml-expansion 'global-binding-of "global-key-binding")
  243.  
  244. ;defproc (ProcedureType, "procedure-type");
  245.  
  246. (ml-expansion 'remove-key-binding "global-unset-key")
  247. (ml-expansion 'remove-binding "global-unset-key")
  248. (ml-expansion 'remove-local-binding "local-unset-key")
  249. (ml-expansion 'remove-all-local-bindings "use-local-map nil")
  250. (ml-expansion 'autoload "ml-autoload")
  251.  
  252. (ml-expansion 'checkpoint-frequency "auto-save-interval")
  253.  
  254. (ml-expansion 'mode-string "mode-name")
  255. (ml-expansion 'right-margin "fill-column")
  256. (ml-expansion 'tab-size "tab-width")
  257. (ml-expansion 'default-right-margin "default-fill-column")
  258. (ml-expansion 'default-tab-size "default-tab-width")
  259. (ml-expansion 'buffer-is-modified "(buffer-modified-p)")
  260.  
  261. (ml-expansion 'file-modified-time "you-lose-on-file-modified-time")
  262. (ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing")
  263.  
  264. (ml-expansion 'lines-on-screen "set-frame-height")
  265. (ml-expansion 'columns-on-screen "set-frame-width")
  266.  
  267. (ml-expansion 'dumped-emacs "t")
  268.  
  269. (ml-expansion 'buffer-size "ml-buffer-size")
  270. (ml-expansion 'dot-is-visible "pos-visible-in-window-p")
  271.  
  272. (ml-expansion 'track-eol-on-^N-^P "track-eol")
  273. (ml-expansion 'ctlchar-with-^ "ctl-arrow")
  274. (ml-expansion 'help-on-command-completion-error "completion-auto-help")
  275. (ml-expansion 'dump-stack-trace "backtrace")
  276. (ml-expansion 'pause-emacs "suspend-emacs")
  277. (ml-expansion 'compile-it "compile")
  278.  
  279. (ml-expansion '!= "/=")
  280. (ml-expansion '& "logand")
  281. (ml-expansion '| "logior")
  282. (ml-expansion '^ "logxor")
  283. (ml-expansion '! "ml-not")
  284. (ml-expansion '<< "lsh")
  285.  
  286. ;Variable pause-writes-files
  287.  
  288. ;;; mlconvert.el ends here
  289.